home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 April: Mac OS SDK / Dev.CD Apr 98 SDK2.toast / Development Kits (Disc 2) / ScriptX / Documentation / Code Examples from Docs / compguid / collectn / ucollect.sx < prev   
Encoding:
Text File  |  1996-05-21  |  3.9 KB  |  133 lines  |  [TEXT/ttxt]

  1. -- <<<
  2.  
  3. object cantChangeOrder (CollectionException)
  4.     name:"cantChangeOrder"
  5.     format:"Attempt to sort or change the order of a collection"
  6. end
  7.  
  8. class UniformCollection (IndirectCollection)
  9.     instance vars
  10.         keyType -- class to which keys must belong
  11.         valueType -- class to which values must belong
  12.         
  13.     instance methods
  14.         method init self #rest args #key keyType: valueType: -> (
  15.             apply nextMethod self args
  16.             if isAKindof self.targetCollection \
  17.                     ImplicitlyKeyedCollection then (
  18.                 self.keyType := @implicit
  19.             )
  20.             else (
  21.                 if keyType = unsupplied then
  22.                     report keywordRequired @keytype
  23.                 else if isAKindOf keyType Behavior then
  24.                     self.keyType := keyType
  25.                 else
  26.                     report badParameter #(keyType, init, self,
  27.                         "keyType must be a class.")
  28.             )
  29.             if valueType = unsupplied then
  30.                 report keywordRequired @valueType
  31.             else if isAKindOf valueType Behavior then
  32.                 self.valueType := valueType
  33.             else
  34.                 report badParameter #(valueType, init, self,
  35.                     "valueType must be a class.")
  36.         )
  37.         -- keyUniformityGetter and uniformityGetter can be 
  38.         -- specialized at the class or instance level
  39.         method keyUniformityGetter self -> @sameClass
  40.         method keyUniformityClassGetter self -> self.keyType
  41.         method uniformityGetter self -> @sameClass
  42.         method uniformityClassGetter self -> self.valueType
  43.         method isAppropriateObject self addedObject -> (
  44.             case (self.uniformity) of
  45.                 @sameClass: (
  46.                     if (getClass addedObject == self.valueType) then
  47.                         return true
  48.                     else
  49.                         return false
  50.                 )
  51.                 @commonSuperclass:(
  52.                     if (isAKindOf addedObject self.valueType) then
  53.                         return true
  54.                     else
  55.                         return false
  56.                 )
  57.                 otherwise:
  58.                     report generalError \
  59.                         "inappropriate value for uniformity"
  60.             end
  61.         )
  62.         method add self key value -> (
  63.             if self.keyType == @implicit then (
  64.                 nextMethod self key value
  65.             )
  66.             else (
  67.                 case (self.keyUniformity) of
  68.                     @sameClass: (
  69.                         if (getClass key == self.keyType) then
  70.                             nextMethod self key value
  71.                         else 
  72.                             report badkey (#(self, key) as Pair)
  73.                     )
  74.                     @commonSuperclass:(
  75.                         if (isAKindOf key self.keyType) then
  76.                             nextMethod self key value
  77.                         else
  78.                             report badkey (#(self, key) as Pair)
  79.                     )
  80.                     otherwise:                                                                        
  81.                         report generalError \
  82.                             "inappropriate value for keyUniformity"
  83.                 end
  84.             )
  85.         )
  86.         -- reports the cantChangeOrder exception
  87.         method repXcantChangeOrder self ->
  88.             report cantChangeOrder undefined
  89.         
  90.         -- the rest of these are error checking to
  91.         -- prevent invalid calls on the collection
  92.         method addNth self ordinal value -> repXcantChangeOrder self
  93.         method append self value -> repXcantChangeOrder self
  94.         method appendNew self value -> repXcantChangeOrder self
  95.         method moveBackward self value -> repXcantChangeOrder self
  96.         method moveForward self value -> repXcantChangeOrder self
  97.         method moveToBack self value -> repXcantChangeOrder self
  98.         method moveToFront self value -> repXcantChangeOrder self
  99.         method prepend self value -> repXcantChangeOrder self
  100.         method prependNew self value -> repXcantChangeOrder self
  101.         method setLast self value -> repXcantChangeOrder self
  102.         method setNth self ordinal value -> repXcantChangeOrder self
  103.         method sort self ltFunction -> repXcantChangeOrder self
  104. end
  105.         
  106.         
  107.  
  108. -- examples of usage
  109. global myArray := new UniformCollection \
  110.     targetCollection:(new Array initialSize:10) \
  111.     valueType:String
  112. method uniformityGetter self {object myArray} -> @commonSuperClass
  113. add myArray empty ("Grok" as String)
  114. add myArray 1 "Voodoo"
  115. global myBtree := new UniformCollection \
  116.     targetCollection:(new BTree) \
  117.     keyType:NameClass \
  118.     valueType:String
  119. add myBtree @elephant ("Trunk" as String)
  120. -- test that you cannot add a StringConstant value to myBTree
  121. guard (
  122.     add myBtree @pig "Snout"
  123.     print "this line should not print!"
  124. )
  125. catching
  126.     all: (
  127.         print "attempt to give a pig a snout foiled"
  128.         add myBtree @pig ("Tail" as String)
  129.         caught undefined
  130.     )
  131. end
  132. -- >>>
  133.